home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / BARNET / COMPILER / SATHER / !Sather / Library / Containrs / sa / a_alg next >
Text File  |  1996-06-01  |  4KB  |  133 lines
  1. ---------------------------> Sather 1.1 source file <--------------------------
  2. -- a_alg.sa: Miscellaneous algorithms that may be applied to arrays
  3. -- Author: Benedict A. Gomes <gomes@samosa.ICSI.Berkeley.EDU>
  4. -- Copyright (C) 1995, International Computer Science Institute
  5. -- $Id: a_alg.sa,v 1.7 1996/06/01 21:36:04 gomes Exp $
  6. --
  7. -- COPYRIGHT NOTICE: This code is provided WITHOUT ANY WARRANTY
  8. -- and is subject to the terms of the SATHER LIBRARY GENERAL PUBLIC
  9. -- LICENSE contained in the file: Sather/Doc/License of the
  10. -- Sather distribution. The license is also available from ICSI,
  11. -- 1947 Center St., Suite 600, Berkeley CA 94704, USA.
  12. -------------------------------------------------------------------
  13. class A_ALG{ETP,ATP<$ARR{ETP}} is
  14.    -- Miscellaneous array algorithms
  15.    -- Usage:
  16.    --     a: ARRAY{FLT} := |1.0,2.0,3.0,3.0|;
  17.    --     a_alg: A_ALG{INT,ARRAY{INT}}; -- dummy variable
  18.    --     Counting 3s in the array
  19.    --       number_of_threes: INT := a_alg.count(a,3.0);
  20.    --     Getting an array of indices
  21.    --       index_array:ARRAY{INT} := a_alg.inds(a);
  22.    include COMPARE{ETP};
  23.    
  24.    equals(a: ATP,e: $ARR{ETP}): BOOL is
  25.       -- Returns true if all of "e"'s elements are equal to a's elts
  26.       if e.size /= a.size then return false end;
  27.       i ::= 0; sz ::= a.size; loop until!(i = sz);
  28.      if ~elt_eq(e[i],a[i]) then return false end ;
  29.      i := i + 1;
  30.       end;   
  31.       return true
  32.    end;
  33.  
  34.    count(a: ATP,v:ETP):INT is
  35.       -- The number of elements that are `elt_eq' to `v'.
  36.       r::=0; 
  37.       i ::= 0; sz ::= a.size; loop until!(i = sz);
  38.      if elt_eq(a[i],v) then r := r + 1; end;
  39.      i := i + 1;
  40.       end;      
  41.       return r 
  42.    end;
  43.  
  44.    inds(a: ATP): ARRAY{INT} is
  45.       -- Return an index array which is the same size as self and
  46.       -- is set to the values of the indices
  47.       sz: INT := a.size;
  48.       res: ARRAY{INT} := #(sz);
  49.       i: INT := 0; loop until!(i >= sz); res[i] := i; i := i + 1; end;
  50.       return res
  51.    end;
  52.    
  53.    replace_if(a: ATP,test: ROUT{ETP}:BOOL,replacement_value: ETP) is
  54.       i:INT :=0; asz ::= a.size; loop until!(i>=asz);
  55.      if test.call(a[i]) then a[i] := replacement_value; end;
  56.      i := i + 1;
  57.       end;
  58.    end;
  59.    
  60.    replace(a: ATP, old_elt,new_replacement: ETP) is
  61.       -- Replace elements that are `elt_eq' to `o' by `n' wherever it occurs
  62.       i:INT :=0; asz ::= a.size; loop until!(i>=asz);
  63.      if elt_eq(a[i],old_elt) then a[i] := new_replacement end;
  64.      i := i + 1;
  65.       end;
  66.    end;
  67.    
  68.    mismatch(a:ATP,pattern: ARRAY{ETP}):INT is
  69.       -- The index of the first element of self which differs from 
  70.       -- `a'. -1 if self is a prefix of `a' or self is void.
  71.       if void(a) then return -1 end;
  72.       loop r::=a.ind!; if ~elt_eq(a[r],pattern.elt!) then return r end end;
  73.       return -1 
  74.    end;
  75.  
  76.  
  77.    -- Applicative functions on arrays
  78.    map(a: ATP,r:ROUT{ETP}:ETP) is
  79.       -- Set each element of self to the result of applying `r' to it.
  80.       i ::= 0; sz ::= a.size; loop until!(i = sz);
  81.      a[i] := r.call(a[i]);
  82.      i := i + 1;
  83.       end;
  84.    end;
  85.  
  86.    reduce(a:ATP, r:ROUT{ETP,ETP}:ETP, start_value:ETP) :ETP is
  87.       -- Combine all the elements of self by applying `r' over elements
  88.       -- in the order determined by ind!
  89.       res: ETP := start_value;
  90.       i ::= 0; sz ::= a.size;
  91.       loop until!(i = sz);
  92.      res := r.call(res,a[i]);  
  93.      i := i + 1;
  94.       end;     
  95.       return res;
  96.    end;
  97.    
  98.    scan(a:ATP, r:ROUT{ETP,ETP}:ETP, start_value:ETP) is
  99.       -- Set each element in a to the result of applying `r' left to
  100.       -- right to the array up to the element. The first element is left
  101.       -- unchanged. 
  102.       cur_accum: ETP := start_value;
  103.       i ::= 0; sz ::= a.size;
  104.       loop until!(i>=sz);
  105.      cur_val: ETP := a[i];
  106.      cur_accum := r.call(cur_accum,cur_val);
  107.      a[i] := cur_accum;
  108.      i := i + 1;
  109.       end;
  110.    end; 
  111.    
  112.    str(a: ATP): STR is
  113.       -- Prints out a string version of the array of the components 
  114.       -- that are under $STR, and their associated indices
  115.       res ::= #FSTR("{");
  116.       i:INT :=0; asz ::= a.size; loop until!(i>=asz);
  117.      e ::= a[i];
  118.      res := res+",".separate!(elt_str(e,i));
  119.      i := i + 1;
  120.       end;
  121.       res := res +"}";
  122.       return(res.str);
  123.    end;
  124.  
  125.    private elt_str(e: ETP,i: INT): STR is
  126.       typecase e 
  127.       when $STR then return e.str  else return "Unprintable:"+i end;
  128.    end;  
  129.  
  130. end; -- class A_ALG{ETP,ATP<$ARR{ETP}}
  131. -------------------------------------------------------------------
  132.  
  133.